;;; -*- Syntax: Common-lisp; Package: PZ; Default-character-style: (:FIX :BOLD :NORMAL) -*-

;;; FLUSH, NEXT and ADD are the three operations allowed on the FIFO-QUEUE.

(defun flush (queue)
  (setf (fifo-queue-line queue) nil))

(defun next (queue)
  (when (null (fifo-queue-line queue))
    (showboard *base-board*)
    (error "Loses - the queue is empty"))
  (pop (fifo-queue-line queue)))

(defun add (child queue)
  (setf (fifo-queue-line queue)
	(nconc (fifo-queue-line queue)
	       (list child))))


;;; COPY-BOARD-POSITION copies one board position onto another.  It will tolerate to-board
;;; EQing from-board.

(defun copy-board-position (to-board from-board)
  (scl:copy-array-contents (board-position from-board)(board-position to-board))
  (setf (board-blank to-board)(board-blank from-board))
  (setf (board-completed-chain to-board)(board-completed-chain from-board))
  (setf (board-last-complete-row to-board)(board-last-complete-row from-board))
  (setf (board-moves to-board)(board-moves from-board))
  (setf (board-blank-origin to-board)(board-blank-origin from-board))
  to-board)


;;; POSITION-CONTENTS and CURRENT-POSITION are duals.  The first, given a place, says what
;;; tile occupies it.  The other, given a tile, says what place it occupies.
;;; CURRENT-POSITION is not stored directly and must search.  

(defun position-contents (place board)
  (aref (board-position board) (1- place)))

(defun current-position (tile board)
  (loop for count from 1 to (board-size board)
	when (eq (position-contents count board) tile)
	  return count
	finally (error "Never found ~s in ~s~& Contents: ~s~&"
		       tile (board-name board) (coerce (board-position board) 'list))))

;;; The definitions of both ROW and COLUMN show the curse of zero based indexing.

(defun row (place board)
  (1+ (floor (1- place)(board-side board))))

(defun column (place board)
  (1+ (mod (1- place) (board-side board))))


;;; Two tiles are contiguous if they are touching edges, or separated only by the blank.

(defun contiguous (tile1 tile2 board)
  (let ((p1 (current-position tile1 board))
	(p2 (current-position tile2 board)))
    (or (and (= (row p1 board)(row p2 board))
	     (= (abs (- (column p1 board)(column p2 board))) 1))
	(and (= (column p1 board)(column p2 board))
	     (= (abs (- (row p1 board)(row p2 board))) 1))
	(and (not (or (eq tile1 :blank)(eq tile2 :blank)))
	     (contiguous tile1 :blank board)
	     (contiguous tile2 :blank board)))))

(defun board-size (board)
  (array-dimension (board-position board) 0))

(defun leftsquare (place board)
  (1+ (*  (board-side board) (1- (row place board)))))

;;; If we get through every place in the board without finding a square which is not filled
;;; with its correct number, we've succeeded.

(defun goalp (board)
  (let ((count-limit (board-size board)))
    (do ((idx 1 (1+ idx)))
	((or (= idx count-limit)
	     (not (equal idx (position-contents idx board))))
	 (= idx count-limit)))))



(defun stored-successors (movelist board)
  (cond ((null movelist)			; NULL MOVELIST iff generating 
	 (when (board-moves board)		; moves from original board.
	   (error "This movelist ~s doesn't match the board ~s."
		  movelist (board-name board)))
	 (aref  *adjacency-moves* (1- (board-blank board))))
	((eq movelist (board-moves board))	; When making moves from base-board, 
	 (aref  *adjacency-moves*		; don't need to filter retraced steps
		(1- (board-blank board))))
	(t (remove (or (second movelist)	; Filter retraced steps.  When 1 move away
		       (board-blank board))	; from original board, have to look at its 
		   (aref  *adjacency-moves*	; blank to see where blank camefrom
			  (1- (car movelist)))))))

;;; BETTER and WORSE, if they succeed, return the heuristic that succeeded.  They go through
;;; *worse-measures* or *better-measures*, applying each heuristic until one returns
;;; NonNull.

(defun better (newboard oldboard)
  (first (member-if #'(lambda (evaluator)
			(funcall evaluator newboard oldboard))
		    *better-measures*)))

(defun worse (newboard oldboard)
  (first (member-if #'(lambda (evaluator)
			(funcall evaluator newboard oldboard))
		    *worse-measures*)))